home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / PATCHFIL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  5KB  |  184 lines
  1.  
  2. PROGRAM PATCH;
  3.  
  4. {$M 20000,0,655000}
  5.  
  6. Uses DOS, PbMISC, PbDATA, PbOBJS, PbPARMS, PbOUT0;
  7.  
  8.  
  9. {
  10. Description : Text string find and replace
  11.  
  12. Author      : Howard Richoux
  13. Date        : 12/9/93
  14. Last revised: 12/31/93 hnr 1.02 cleanup
  15.                2/18/94 hnr 1.04 new libraries
  16. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  17. Status      : Placed in the Public Domain by HNR Software 1/29/94
  18. Published in: none
  19.  
  20. Config Parameters        Meaning                                Default
  21.        FIND              string to find                         ''
  22.        REPLACE           replace with                           ''
  23.        BOTH              ignore CASE                            'YES'
  24.        ALL               replace all occurances on each line    'YES'
  25.        CMDFILE           file of replacement commands           ''
  26.  
  27. }
  28.  
  29. var fndstr   : string;
  30.     repstr   : string;
  31.     bothflag : boolean;
  32.     allflag  : boolean;
  33.     cmdfile  : string;
  34.     fnd,rep  : STRA_object;
  35.  
  36. {*****************************************************************}
  37.  
  38.  
  39. Procedure ProcessString(var s : string; var fnd,rep : STRA_object;
  40.                         both,all : boolean);
  41. var fs,rs : string;
  42.     i     : integer;
  43.      begin
  44.      for i := 1 to fnd.count do
  45.           begin
  46.           fs := fnd.fetchN(i);
  47.           rs := rep.fetchN(i);
  48.           s  := FindAndReplaceStr(s,fs,rs,both,all);
  49.           end;
  50.      end;
  51.  
  52.  
  53. Procedure ProcessFile(fn : string; var fnd,rep : STRA_object;
  54.                         both,all : boolean);
  55. var s,s0,s1,t1nm, t2nm, t3nm : string;
  56.     T1,T2    : TFILE_object;
  57.     n       : integer;
  58.      begin
  59.      OUT('File: '+fn);
  60.      if fnd.count < 1 then
  61.           begin
  62.           OUT('  No changes requested.');
  63.           exit;
  64.           end;
  65.      n := 0;
  66.      t1nm := fn;
  67.      T1.init(t1nm,false);
  68.      t2nm := fn;
  69.      ForceExt(t2nm,'NEW');
  70.      EraseFile(t2nm);
  71.      T2.init(t2nm,true);
  72.      while T1.fetchnext(s) do
  73.           begin
  74.           s0 := s;
  75.           inc(n);
  76.           ProcessString(s,fnd,rep,both,all);
  77.           T2.append(s);
  78.           if s0 <> s then OUT(' ('+integerstr(n,4)+') '+s);
  79.           end;
  80.      T2.done;
  81.      T1.done;
  82.      OUT(' ');
  83.      ForceRenameToBAK(t1nm);    { .pas -> .bak }
  84.      RenameFile(t2nm,fn);       { .NEW -> .pas }
  85.      end;
  86.  
  87.  
  88. Procedure GoOn;      { Initialization is over, do some work.}
  89. var i : integer;
  90.      begin
  91.      OUT('Changing File: ['+pCurrFName+']');
  92.      for i := 1 to fnd.count do
  93.           OUT('                    ['+fnd.fetchN(i)+']'+
  94.                 ' --> ['+rep.fetchN(i)+']');
  95.      OUT(' ');
  96.      ProcessFile(pCurrFName,fnd,rep,bothflag,allflag);
  97.      end;
  98.  
  99.  
  100. Procedure LoadCommands(cmdfile : string; var fnd,rep : STRA_object);
  101. var t : TFILE_object;
  102.     s,fs,rs : string;
  103.      begin
  104.      fs := '';
  105.      rs := '';
  106.      t.init(cmdfile,false);
  107.      while t.fetchnext(s) do
  108.           begin
  109.           fs := GetLeftStr(s,'/');
  110.         {  delete(fs,length(fs),1);}
  111.           trim(fs);
  112.           trim(s);
  113.           rs := RemoveBrackets(s);
  114.           fs := RemoveBrackets(fs);
  115.           if fs <> '' then
  116.                begin
  117.                fnd.append(fs);
  118.                rep.append(rs);
  119.                end;
  120.           fs := '';
  121.           rs := '';
  122.           end;
  123.      t.done;
  124.      end;
  125.  
  126.  
  127. Procedure Init;
  128. var s : string;
  129.      begin
  130.      fnd.init(100);   { strings to find }
  131.      rep.init(100);   { replace them with }
  132.  
  133.      AddParm(1,'FIND','');
  134.      AddParm(1,'REPLACE','');
  135.      AddParm(1,'BOTH','YES');
  136.      AddParm(1,'ALL','YES');
  137.      AddParm(1,'CMDFILE','');
  138.  
  139.      StandardOUTInit;
  140.  
  141.      OUTSetNoPause;
  142.  
  143.      cmdfile    := GetParmStr('CMDFILE');
  144.      if fileexists(cmdfile) then
  145.           begin
  146.           LoadCommands(cmdfile,fnd,rep);
  147.           end
  148.      else if cmdfile <> '' then
  149.           begin
  150.           writeln('Unable to file command file: [',cmdfile,']');
  151.           end
  152.      else begin
  153.           fndstr     := RemoveBrackets(GetParmStr('FIND'));
  154.           patchstr(fndstr,'^',' ');
  155.           repstr     := RemoveBrackets(GetParmStr('REPLACE'));
  156.           patchstr(repstr,'^',' ');
  157.           if fndstr <> '' then
  158.                begin
  159.                fnd.append(fndstr);
  160.                rep.append(repstr);
  161.                end;
  162.           end;
  163.  
  164.      bothflag   := CheckOK('BOTH');
  165.      allflag    := CheckOK('ALL');
  166.  
  167.      if paramcount > 0 then pCurrFName := paramstr(1);
  168.      end;
  169.  
  170.  
  171.     BEGIN
  172.     pProgID := 'PATCH 1.04';
  173.     Init;
  174.  
  175.     if ParamCount > 0 then
  176.          begin
  177.          GoOn;
  178.          end
  179.     else ShowDocFile;
  180.     OUTdone;
  181.     end.
  182.  
  183.  
  184.